home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
64'er
/
64ER_CD.iso
/
86xx
/
8603.d64
/
umformer print-s
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
1995-03-30
|
10KB
|
390 lines
10 V=53248
20 POKEV+21,0 : POKEV+29,0 : POKEV+23,0 : POKEV+16,0
30 PRINTCHR$(142);CHR$(8)
40 POKE53280,11:POKE53281,12:POKE646,0
50 PRINT"[147] PRINT-SHOP-UMFORMER [146]";
60 PRINT" [146]";
70 PRINT" VON ANDREAS NOTHAFT 1985 [146]";
80 PRINT" 0 [146] - PROGRAMM-ENDE"
90 PRINT" 1 [146] - INFORMATIONEN"
100 PRINT" 2 [146] - DIRECTORY ANZEIGEN"
110 PRINT"----------------------------------------";
120 PRINT" 3 [146] - 1 HIRES-SPRITE "
130 PRINT" 4 [146] - 1 MULTI-C-SPRITE (NORMALGROESSE)"
140 PRINT" 5 [146] - 2 HIRES-SPRITES (NEBENEINANDER)"
150 PRINT" 6 [146] - 2 HIRES-SPRITES (UEBEREINADER)"
160 PRINT" 7 [146] - 4 HIRES-SPRITES"
170 GETG$:IFG$=""THEN170
180 IF G$="0" THEN 270
190 IF G$="1" THEN 310
200 IF G$="2" THEN 3730
210 IF G$="3" THEN 520
220 IF G$="4" THEN 910
230 IF G$="5" THEN 1810
240 IF G$="6" THEN 2140
250 IF G$="7" THEN 2600
260 GOTO 170
270 PRINT"[147]SIND SIE SICHER ??? (J/N)"
280 GET G$:IFG$="" THEN 280
290 IFG$="J" THEN SYS 64738
300 RUN
310 REM ******************************
320 REM ***** INFORMATIONEN *****
330 REM ******************************
340 A$="INFORMATIONEN":GOSUB3090
350 PRINT" DIESES PROGRAMM VERAENDERT DIE DATEN"
360 PRINT" VON SPRITES SO, DASS SIE VON DEM"
370 PRINT" PROGRAMM ";CHR$(34);"PRINT SHOP";CHR$(34);" VERWENDET"
380 PRINT" WERDEN KOENNEN."
390 PRINT" AUFGRUND DER AUFLOESUNGS-PUNKTE"
400 PRINT" FUNKTIONIERT DIESES PROGRAMM NUR MIT"
410 PRINT" DER PRINT SHOP VERSION FUER"
420 PRINT" NICHT COMMODORE DRUCKER[146]."
430 PRINT" DIE EINZULESENDEN DATEN KOENNEN"
440 PRINT" ENTWEDER AUS EINER SEQUENTIELLEN DATEI"
450 PRINT" ODER AUS EINEM PROGRAMM-FILE BESTEHEN."
460 PRINT" ES WERDEN JEWEILS NUR DIE ERSTEN "
470 PRINT" 63 BYTES GELESEN."
480 PRINT" VIEL ERFOLG MIT DIESEM PRG WUENSCHT"
490 PRINT" ANDREAS, THORSTEN UND MATTHIAS [146]"
500 GOSUB3150
510 RUN
520 REM ******************************
530 REM 1 HIRES-SPRITE (NORMALGROESSE)
540 REM ******************************
550 AZ=1:GOSUB2940
560 A$="1 HIRES-SPRITE (NORMALGROESSE)"
570 GOSUB3090 :REM NAME-AMZEIGEN
580 POKEV+21,3
590 POKE2040,192:POKE2041,192
600 POKEV,126:POKEV+1,140
610 POKEV+2,170:POKEV+3,130
620 POKEV+29,2:POKEV+23,2
630 POKEV+39,15:POKEV+40,15
640 GOSUB3640
650 POKEV+21,0
660 GOSUB3050: REM FILL MIT 00
670 AN=12288 : A1=22584 : Z1=0 :Z=0:S1=00:B=0
680 PRINT"";
690 FORTH=0TO20:PRINTTH:NEXT:PRINT"";
700 FOR P=1 TO 21
710 PRINT"+"
720 FOR M=1 TO 3
730 A=PEEK(AN+Z)
740 FOR N=21 TO 0 STEP -3
750 IF A>=2^(N/3) THEN B=B+2^(N+2):B=B+2^(N+1):B=B+2^N :A=A-2^(N/3)
760 NEXT N : Z=Z+1
770 C=INT(B/65536):D=INT((B-(C*65536))/256):E=B-(C*65536+D*256)
780 B=0
790 POKEA1+Z1+S1,C : POKEA1+Z1+S1+11,C
800 POKEA1+Z1+S1+1,D:POKEA1+Z1+S1+11+1,D
810 POKEA1+Z1+S1+2,E:POKEA1+Z1+S1+11+2,E
820 Z1=Z1+3
830 NEXT M : S1=S1+22 : Z1=0
840 NEXT P
850 GOSUB3220:REM SAVE
860 GOSUB3360:REM FEHLER ???
870 IF A=0 THEN RUN
880 PRINT" DISK-ERROR [146]: ";A;A$;B;C
890 GOSUB3150
900 GOTO850
910 REM ******************************
920 REM *1 MULTI-C-SPRITE (NORMALGR.)*
930 REM ******************************
940 AZ=1:GOSUB2940
950 A$="1 MULTI-C-SPRITE (NORMALGR.)"
960 GOSUB3090
970 GOSUB3050
980 POKE2040,192
990 POKE2041,192
1000 V=53248
1010 POKEV+21,3
1020 POKEV,220:POKEV+1,185
1030 POKEV+2,5:POKEV+3,175:POKEV+16,2
1040 POKEV+28,3:POKEV+29,2:POKEV+23,2
1050 C1=15 : C2=11 : C3=00 : C4=12
1060 POKEV+33,C1 : POKEV+37,C2 : POKEV+38,C3 : POKEV+39,C4 : POKEV+40,C4
1070 PRINT"":FORI=1 TO 40 :PRINT" ";:NEXT
1080 PRINT"":FORI=1 TO 40 :PRINT" ";:NEXT
1090 A$="1 MULTI-C-SPRITE (NORMALGR.)":GOSUB3090
1100 PRINT" F1 [146] = MULTI-COLOR-FARBE #01"
1110 PRINT" F3 [146] = MULTI-COLOR-FARBE #02"
1120 PRINT" F5 [146] = MULTI-COLOR-FARBE #03"
1130 PRINT" F7 [146] = MULTI-COLOR-FARBE #04"
1140 PRINT" F8 [146] = ZURUECK INS MENUE"
1150 PRINT" RETURN = WEITER IM PROGRAMM"
1160 GET G$:IFG$=""THEN1160
1170 IF G$=CHR$(133) THEN GOSUB 1240
1180 IF G$=CHR$(134) THEN GOSUB 1290
1190 IF G$=CHR$(135) THEN GOSUB 1340
1200 IF G$=CHR$(136) THEN GOSUB 1390
1210 IFG$=CHR$(140)THENRUN
1220 IF G$<>CHR$(13) THEN 1160
1230 GOTO1440
1240 IF C1=0 THEN C1=11 : GOTO1280
1250 IF C1=11 THEN C1=12 : GOTO1280
1260 IF C1=12 THEN C1=15 : GOTO1280
1270 IF C1=15 THEN C1=0
1280 POKEV+33,C1:RETURN
1290 IF C2=0 THEN C2=11 : GOTO1330
1300 IF C2=11 THEN C2=12 : GOTO1330
1310 IF C2=12 THEN C2=15 : GOTO1330
1320 IF C2=15 THEN C2=0
1330 POKEV+37,C2:RETURN
1340 IF C3=0 THEN C3=11 : GOTO1380
1350 IF C3=11 THEN C3=12 : GOTO1380
1360 IF C3=12 THEN C3=15 : GOTO1380
1370 IF C3=15 THEN C3=0
1380 POKEV+38,C3:RETURN
1390 IF C4=0 THEN C4=11 : GOTO1430
1400 IF C4=11 THEN C4=12 : GOTO1430
1410 IF C4=12 THEN C4=15 : GOTO1430
1420 IF C4=15 THEN C4=0
1430 POKEV+39,C4:POKEV+40,C4:RETURN
1440 POKEV+21,0:POKEV+28,0
1450 POKE53280,11:POKE53281,12:POKE646,0
1460 GOSUB3090
1470 A1=22584:Z=0:AN=12288:S1=0
1480 PRINT"";
1490 FORTH=0TO20:PRINTTH:NEXT:PRINT"";
1500 FORP=0TO20:FORK=0TO2:F$="":FF$=""
1520 A=PEEK(AN+(P*3)+K)
1530 FORM=3TO0STEP-1
1540 FORN=3TO0STEP-1
1550 IFA>=2^(M*2+N)THENA=A-2^(M*2+N):B=B+2^N
1560 NEXTN
1570 IFB=0THENF=C1
1580 IFB=1THENF=C2
1590 IFB=2THENF=C4
1600 IFB=3THENF=C3
1610 IFF=0THENF$=F$+"111111":FF$=FF$+"111111"
1620 IFF=11THENF$=F$+"110110" :FF$=FF$+"011011"
1630 IFF=12THENF$=F$+"111000" :FF$=FF$+"000111"
1640 IFF=15THENF$=F$+"000000":FF$=FF$+"000000"
1650 B=0:F=0:NEXTM
1660 FORR=1TO24
1670 IFMID$(F$,R,1)="1"THENG=G+2^(24-R)
1680 IFMID$(FF$,R,1)="1"THENH=H+2^(24-R)
1690 NEXTR
1700 C=INT(G/65536):D=INT((G-(C*65536))/256):E=G-(C*65536+D*256):G=0
1710 POKEA1+Z+S1,C:POKEA1+Z+1+S1,D:POKEA1+Z+2+S1,E
1720 C=INT(H/65536):D=INT((H-C*65536)/256):E=H-(C*65536+D*256):H=0
1730 POKEA1+Z+11+S1,C:POKEA1+Z+12+S1,D:POKEA1+Z+13+S1,E
1740 Z=Z+3:NEXTK:S1=S1+22:Z=0:PRINT"+":NEXTP
1750 GOSUB3220:REM SAVE
1760 GOSUB3360:REM DISK ERROR
1770 IFA=0THENRUN
1780 PRINT" DISK-ERROR [146]: ";A;A$;B;C
1790 GOSUB3150
1800 GOTO1750
1810 REM ******************************
1820 REM 2 HIRES-SPRITES (NEBENEINAND.)
1830 REM ******************************
1840 AZ=2:GOSUB2940
1850 A$="2 HIRES-SPRITES (NEBENEINAND.)"
1860 GOSUB3090
1870 POKEV+21,3
1880 POKE2040,192:POKE2041,193
1890 POKEV,160:POKEV+1,150
1900 POKEV+2,184:POKEV+3,150
1910 POKEV+39,15:POKEV+40,15
1920 GOSUB3640
1930 POKEV+21,0
1940 GOSUB3050
1950 I=0 : A1=12288 : A2=12352 : AA=22695
1960 PRINT"";
1970 FORTH=0TO20:PRINTTH:NEXT:PRINT"";
1980 FORT=1TO3
1990 A=PEEK(A1)
2000 POKEAA,A
2010 AA=AA+1:A1=A1+1
2020 NEXTT
2030 FORT=1TO3
2040 B=PEEK(A2)
2050 POKEAA,B
2060 AA=AA+1:A2=A2+1
2070 NEXTT:AA=AA+5:I=I+1:PRINT"+":IFI<21THEN1980
2080 GOSUB3220
2090 GOSUB3360
2100 IFA=0THENRUN
2110 PRINT" DISK-ERROR [146]: ";A;A$;B;C
2120 GOSUB3150
2130 GOTO2080
2140 REM ******************************
2150 REM 2 HIRES-SPRITES (UEBEREINAND.)
2160 REM ******************************
2170 AZ=2:GOSUB2940
2180 A$="2 HIRES-SPRITES (UEBEREINAND.)"
2190 GOSUB3090
2200 POKEV+21,3
2210 POKE2040,192:POKE2041,193
2220 POKEV,172:POKEV+1,155
2230 POKEV+2,172:POKEV+3,176
2240 POKEV+39,15:POKEV+40,15
2250 GOSUB3640
2260 POKEV+21,0
2270 GOSUB3050 : REM FILL MIT 00
2280 AA=12288 : B=0 : Z=0
2290 A1=22585
2300 PRINT"";
2310 FORTH=0TO20:PRINTTH:NEXT:PRINT"";
2320 FORTH=21TO41:PRINTTAB(10)TH:NEXT:PRINT"";
2330 FOR N=0 TO 20
2340 PRINT"+"
2350 FORM=0TO2
2360 A=PEEK(AA+(N*3+M))
2370 FOR O=14 TO 0 STEP -2
2380 IF A>=2^(O/2)THEN B=B+2^(O+1):B=B+2^O:A=A-2^(O/2)
2390 NEXTO:POKEA1+Z,INT(B/256):POKEA1+Z+1,B-PEEK(A1+Z)*256
2400 Z=Z+2 :B=0 : NEXT M:Z=Z+5
2410 NEXT N
2420 AA=12352 : B=0 : Z=0
2430 A1=22816
2440 PRINT"";
2450 FOR N=0 TO 20
2460 PRINT"+"
2470 FOR M=0 TO 2
2480 A=PEEK(AA+(N*3+M))
2490 FOR O=14 TO 0 STEP -2
2500 IF A>=2^(O/2)THEN B=B+2^(O+1):B=B+2^O:A=A-2^(O/2)
2510 NEXTO:POKEA1+Z,INT(B/256):POKEA1+Z+1,B-PEEK(A1+Z)*256
2520 Z=Z+2 :B=0 : NEXT M:Z=Z+5
2530 NEXT N
2540 GOSUB3220:REM SAVE
2550 GOSUB3360:REM DISK ERROR
2560 IFA=0THENRUN
2570 PRINT" DISK-ERROR [146]: ";A;A$;B;C
2580 GOSUB3150
2590 GOTO2540
2600 REM ******************************
2610 REM ***** 4 HIRES-SPRITES *****
2620 REM ******************************
2630 AZ=4:GOSUB2940
2640 A$="4 HIRES-SPRITES":GOSUB3090
2650 POKEV+21,15
2660 POKE2040,192:POKE2041,193:POKE2042,194:POKE2043,195
2670 POKEV,136:POKEV+1,119
2680 POKEV+2,160:POKEV+3,119
2690 POKEV+4,136:POKEV+5,140
2700 POKEV+6,160:POKEV+7,140
2710 POKEV+39,15:POKEV+40,15:POKEV+41,15:POKEV+42,15
2720 GOSUB3640
2730 POKEV+21,0
2740 GOSUB3050:REMFILL MIT 00
2750 AA=12288 : AB=AA+64:AC=AB+64:AD=AC+64
2760 A1=22585 :A2=22588:A3=22816:A4=22819
2770 T=0:Q=0
2780 PRINT"";
2790 FORTH=0TO20:PRINTTH:NEXT:PRINT"";
2800 FORF=0TO20
2810 PRINT"+"
2820 FORI=0TO2:
2830 A=PEEK(AA+Q):B=PEEK(AB+Q):C=PEEK(AC+Q):D=PEEK(AD+Q)
2840 POKEA1+T,A:POKEA2+T,B:POKEA3+T,C:POKEA4+T,D
2850 Q=Q+1:T=T+1:NEXT:T=T+8
2860 NEXT F
2870 GOSUB3220:REM SAVE
2880 GOSUB3360:REM DISK ERROR
2890 IFA=0THENRUN
2900 PRINT" DISK-ERROR [146]: ";A;A$;B;C
2910 GOSUB3150
2920 GOTO2870
2930 REM******************************
2940 REM***** LOAD - ROUTINE *****
2950 REM******************************
2960 SZ=1:GOSUB3400
2970 IF AZ=1 THEN RETURN
2980 SZ=2:GOSUB3400
2990 IF AZ=2 THEN RETURN
3000 SZ=3:GOSUB3400
3010 IF AZ=3 THEN RETURN
3020 SZ=4:GOSUB3400
3030 RETURN
3040 REM******************************
3050 REM***** FILL MIT 00 *****
3060 REM******************************
3070 FORI=22528 TO 23164 : POKEI,0:NEXT:RETURN
3080 REM******************************
3090 REM**** PRINT UEBERSCHRIFT ****
3100 REM******************************
3110 PRINT"[147] ";A$;
3120 A=LEN(A$):A=A+1:FORI=A TO 39:PRINT" [146]";:NEXT
3130 RETURN
3140 REM******************************
3150 REM******* GET ANY KEY ******
3160 REM******************************
3170 PRINT" BITTE DRUECKEN SIE EINE TASTE !!! [146]";
3180 POKE2023,160:POKE56295,0
3190 GETYY$:IFYY$=""THEN 3190
3200 RETURN
3210 REM******************************
3220 REM*** SAVE PRINT-SHOP GRAFIK ***
3230 REM******************************
3240 PRINT"[147]":A$="SAVE PRINT-SHOP GRAPHIK":GOSUB3090
3250 PRINT" NAME (SAVE) : ";:OPEN1,0:INPUT#1,SN$:CLOSE1:PRINT
3260 OPEN3,8,2,SN$+",P,W"
3270 PRINT#3,CHR$(0);CHR$(88);
3280 FOR I=22528 TO 23164 : PRINT#3,CHR$(PEEK(I));:NEXT
3290 CLOSE3
3300 GOSUB3360
3310 IFA=0THENRETURN
3320 PRINT" DISK-ERROR [146]: ";A;A$;B;C
3330 GETYY$:IFYY$=""THEN3330
3340 GOTO3220
3350 REM******************************
3360 REM***** DISK-ERROR ??? *****
3370 REM******************************
3380 OPEN15,8,15:INPUT#15,A,A$,B,C:CLOSE15
3390 RETURN
3400 :
3410 A$="LOAD ROUTINE ":GOSUB3090
3420 PRINT"NAME FUER SPRITE #";SZ;:OPEN1,0:INPUT#1,N$:CLOSE1:PRINT
3430 N$=LEFT$(N$,16)
3440 PRINT" P[146]ROGRAMM- O. S[146]EQUENTIELLES FILE ?"
3450 GETT$:IFT$=""THEN3450
3460 IF T$="P" THEN 3480
3470 IF T$<>"S" THEN 3450
3480 OPEN2,8,2,N$+","+T$+",R"
3490 IF T$="P" THEN GET#2,M$:GET#2,M$
3500 FORI = 0 TO 62
3510 GET#2,SP$:IFSP$=""THENSP$=CHR$(0)
3520 SP=ASC(SP$)
3530 IF SZ=1 THEN POKE12288+I,SP
3540 IF SZ=2 THEN POKE12352+I,SP
3550 IF SZ=3 THEN POKE12416+I,SP
3560 IF SZ=4 THEN POKE12480+I,SP
3570 NEXT:CLOSE2
3580 GOSUB3360 : IF A=0 THEN RETURN
3590 PRINT" DISK ERROR [146]: ";A;A$;B;C
3600 GOSUB3150
3610 GOTO 2940
3640 PRINT" RICHTIGER SPRITE/SPRITES (J/N) [146]";
3650 POKE2023,160:POKE56295,0
3660 GETG$:IFG$=""THEN3660
3670 IFG$="J"THENFORI=1984TO2023:POKEI,32:NEXT:RETURN
3680 IFG$<>"N"THEN3660
3690 POKEV+21,0:RUN
3700 REM******************************
3710 REM***** DIRECTORY *****
3720 REM******************************
3730 PRINT"[147]"
3740 OPEN1,8,0,"$":KV=0
3750 FORI=0TO30:GET#1,A$:B$=B$+A$:NEXT
3760 PRINT" ";B$
3770 GET#1,A$,B$,E$,F$,G$:FORI=0TO26:GET#1,D$:C$=C$+D$:NEXT
3780 IFF$<=CHR$(0)THENA=0:GOTO3800
3790 A=ASC(F$)
3800 IFG$<=CHR$(0)THENB=0:GOTO3820
3810 B=ASC(G$)
3820 D=A+256*B
3830 IFC$="[199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199]"THENC$="":GOTO3910
3840 IFC$="[255][255][255][255][255][255][255][255][255][255][255][255][255][255][255][255][255][255][255][255][255][255][255][255][255][255][255]"THENC$="":GOTO3910
3850 PRINTD;C$:C$=""
3860 KV=KV+1:IFKV=22THEN3880
3870 GOTO3770
3880 KV=0:GOSUB3150
3890 PRINT"[145] ";:PRINT"[147]":POKE2023,32
3900 GOTO3770
3910 KV=0:GOSUB3150
3920 CLOSE1:RUN